home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Mar / DI9803DM / common / AXTools.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-09  |  4.2 KB  |  117 lines
  1. unit AXTools;
  2.  
  3. interface
  4.  
  5. uses
  6.   AXCtrls, ActiveX;
  7.  
  8. type
  9.   {This class is defined to allow insertion and deletion of the required
  10.    registry settings to signify that this control is "marked as safe"
  11.    for scripting and control initialization. For more info, see MS's
  12.    ActiveX SDK - in the "Security API" section. See TActiveFormControlFactory
  13.    implementation for another example of overriding control factory creation.
  14.    (In Delphi 3.0 and 3.01. 3.02 changed inheritance to expose UpdateRegistry
  15.     as a virtual method of TComObjectFactory instead, so TActiveXControlFactory
  16.     implements an overridden UpdateRegistry that you can browse).
  17.    Also see the unit ObjSafe.pas for the implementation of IObjectSafety}
  18.   TActiveXSafeFactory = class(TActiveXControlFactory)
  19.     procedure UpdateRegistry(Register : boolean); override;
  20.   end;
  21.  
  22.   {Helper functions - see ActiveX SDK for more information}
  23.   function CreateComponentCategory(catid : TIID; catDescription : PWideChar) : HRESULT;
  24.   function RegisterCLSIDInCategory(clsid : TGUID; catid : TGUID) : HRESULT;
  25.   function UnRegisterCLSIDInCategory(clsid : TGUID; catid : TGUID) : HRESULT;
  26.  
  27. implementation
  28.  
  29. uses
  30.   ComObj, ObjSafe;
  31.  
  32. const
  33.   // GUIDs defined in comcat.h section (RTL\WIN\ActiveX)
  34.   IID_IEnumGUID : TGUID = '{0002E000-0000-0000-C000-000000000046}';
  35.   IID_IEnumCategoryInfo : TGUID = '{0002E011-0000-0000-C000-000000000046}';
  36.   IID_ICatRegister: TGUID= '{0002E012-0000-0000-C000-000000000046}';
  37.   IID_ICatInformation: TGUID = '{0002E013-0000-0000-C000-000000000046}';
  38.  
  39. procedure TActiveXSafeFactory.UpdateRegistry(Register: Boolean);
  40. begin
  41.   inherited UpdateRegistry(Register);
  42.   if Register then begin
  43.     // Fix for 3.02 patch, which started quoting the location of the OCX. This causes problems.
  44.     CreateRegKey('CLSID\'+GUIDToString(ClassID)+'\'+ComServer.ServerKey, '', ComServer.ServerFileName);
  45.     CreateComponentCategory(CATID_SafeForScripting, 'Controls that are safely scriptable');
  46.     CreateComponentCategory(CATID_SafeForInitializing, 'Controls safely initializable from persistent data');
  47.     RegisterCLSIDInCategory(ClassID, CATID_SafeForScripting);
  48.     RegisterCLSIDInCategory(ClassID, CATID_SafeForInitializing);
  49.   end else begin
  50.     UnRegisterCLSIDInCategory(ClassID, CATID_SafeForScripting);
  51.     UnRegisterCLSIDInCategory(ClassID, CATID_SafeForInitializing);
  52.   end;
  53. end;
  54.  
  55. function CreateComponentCategory(catid : TGUID; catDescription : PWideChar) : HRESULT;
  56. const
  57.   MAX_LEN = 127;
  58. var
  59.   pcr : ICatRegister;
  60.   catinfo : PCATEGORYINFO;
  61.   len : integer;
  62.   s : string;
  63. begin
  64.   Result:=CoCreateInstance(CLSID_StdComponentCategoryMgr, nil, CLSCTX_INPROC_SERVER,
  65.     IID_ICatRegister, pcr);
  66.   OleCheck(Result);
  67.  
  68.   // Make sure the HKCR\Component Categories\{..catid...} key is registered
  69.   New(catinfo);
  70.   try
  71.     catinfo^.catid := catid;
  72.     catinfo^.lcid := $0409; // english
  73.  
  74.     // Make sure the provided description is not too long.
  75.     // Only copy the first 127 characters if it is
  76.     s:=WideCharToString(catDescription);
  77.     len := length(s);
  78.     if len>MAX_LEN then
  79.       SetLength(S, MAX_LEN);
  80.     StringToWideChar(s, catinfo^.szDescription, len+1); // Need room for NULL character too
  81.  
  82.     Result := pcr.RegisterCategories(1, catinfo);
  83.   finally
  84.     Dispose(catinfo);
  85.   end;
  86. end;
  87.  
  88. function RegisterCLSIDInCategory(clsid : TGUID; catid : TGUID) : HRESULT;
  89. var
  90.   pcr : ICatRegister;
  91.   rgcatid : array[0..1] of TGUID;
  92. begin
  93.   Result := CoCreateInstance(CLSID_StdComponentCategoryMgr, nil, CLSCTX_INPROC_SERVER,
  94.     IID_ICatRegister, pcr);
  95.   OleCheck(Result);
  96.  
  97.   // Register this category as being "implemented" by the class.
  98.   rgcatid[0] := catid;
  99.   Result := pcr.RegisterClassImplCategories(clsid, 1, @rgcatid);
  100. end;
  101.  
  102. function UnRegisterCLSIDInCategory(clsid : TGUID; catid : TGUID) : HRESULT;
  103. var
  104.   pcr : ICatRegister;
  105.   rgcatid : array[0..1] of TGUID;
  106. begin
  107.   Result := CoCreateInstance(CLSID_StdComponentCategoryMgr, nil, CLSCTX_INPROC_SERVER,
  108.     IID_ICatRegister, pcr);
  109.   OleCheck(Result);
  110.  
  111.   // Unregister this category as being "implemented" by the class.
  112.   rgcatid[0] := catid;
  113.   Result := pcr.UnRegisterClassImplCategories(clsid, 1, @rgcatid);
  114. end;
  115.  
  116. end.
  117.